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(ZTITLE "FORTRAN CLOSE and CLOSE' 

ow = '1-021' if CLOSE.B32 Edit: SBL1021 


BEGIN 
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it COPYRIGHT (c) 1978, 1980, 1982, 1984 BY 
'* DIGITAL EQUIPMENT €ORPORATION, MAYNARD, MASSACHUSETTS. 
' ALL RIGHTS RESERVED. 


'® THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED 

ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE 
FTWARE OR ANY OTHER 
MADE AVAILABLE TO ANY 


® 

® 
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te 

! * 
i TRANSFERRED. * 
! * 
is THE INFORMATION IN THIS SOFTWARE 1S SUBJECT TO CHANGE WITHOUT NOTICE  * 
® 

® 

ou 

* 

® 

® 

® 

* 


t® AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 
!® CORPORATION. 


is DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
'® SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 

it 
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' FACILITY: FORTRAN Support Library - user callable 
i ABSTRACT: 


This module closes a file on a specified logical unit 
(LUN) and deallocates the I/0 statement block (ISB) and 
RMS Record Access Block (RAB) conrol blocks which were 
allocated by OPEN or default OPEN for this LUN. 


i ENVIRONMENT: User access level; re-entrant, AST level or not. 
i AUTHOR: Thomas N. Hastings, CREATION DATE: 28-Apr-77; Version 01 


4 
1 
1 
1 
' 
i 
' 
{ 
1 
i] 
i 
1 
' 
i MODIFIED BY: 

! Thomas N. Hastings, 28-Apr-77, Version 01 

! (Previous edit history removed. SBL 30-Sep-1982) 

! 1-017 = Move the BUILTIN ACTUALCOUNT into the routine. 

! The next BLISS coupler will require this. JBS 20-Aug-1980 
} 1-018 - Age OFF pst to calling sequence for FORSSOPECLO_ARG. JAW 

. = u = 

! 1-019 - If there is a FAB still hanging around, deallocate it. DGP_18-Dec-19 
' 1-020 - Reflect separation of FORS$ CCB structures from BASIC. SBL 30-Sep-198 
1-021 = Remove deallocation of FAB. SBL 20-Jan-1983 
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7 05 ' 
§ 09 | PROLOGUE FILE: 
60 05 
61 0 REQUIRE ‘RTLIN:FORPROLOG’; ! FORTRAN definitions 
64 i TABLE OF CONTENTS: | 
66 ‘ | 
67 FORWARD ROUTINE —s ‘ 
os FORSCLOSE; ! FORTRAN CLOSE statement 
70 ' | 
71 : EQUATED SYMBOLS: 
i NONE 
74 i 
i OWN STORAGE: 
76 i 
77 NONE 
i 
i 


a ROUTINE 
FORSSCPECLO_ARG : NOVALUE, 
FORSS$SIGNAL_STO : NOVALUE, 


FORSSERR_OPECLO, 


Get OPEN/CLOSE arguments 
Convert FORTRAN error# 
to 32 condition code and SIGNAL_STOP 
OPEN/CLOSE error condition handler | 
resignals or unwinds depending on whether user specified E | 
ae PEN module) 

Push down active I/0 and allocate 
LUB/1SB/RAB if not already for unit. 
Pop LUB/ISB/RAB 
after popping. back previous LUB/ISB/RAB, if any. | 


} 
| 
EXTERNAL REFERENCES: | 
| 
| 


FORSS$CB_PUSH : JSB_CB_PUSH NOVALUE, 
FORSS$CB_POP : JSB_CB_RET NOVALUE, 


FORSSFREE_ VM : NOVALUE, 


Deallocate F 
FORSSCLOSE_FILE : CALL_CCB; 


Internal file close 


~ 

wu 
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GLOBAL ROUTINE FORSCLOSE ( ' FORTRAN CLOSE statement 
KEYWD, H aareare code = repeated arguments 
INFO) ' value of keyword (optional 
= ! value is TRUE iff successful, 
! FALSE if error and err= present. 


lee 


ABSTRACT: | 


tng! ah: CLOSE statement keywords: 
attributes specified in the encoded keyword parameters. 

The keywords are UNIT=, DISPOSE=, and ERR=. 

DISPOSE= may have one of, ‘SAVE’, ‘PRINT’, or ‘DELETE’ values 
which overrides the DISPOSE= specification of the OPEN 

on that LUN. Call FORSSCLOSE_FILE to RMS close the file. 

Flag the logical unit as closed. 

Deallocate LUB/ISB/RAB for this LUN 


FORMAL PARAMETERS: 


The following pair is repeated for each user specified keyword: 
KEYWD.rlu.v Contains KEY<7:0>, ARGTYPE<15:8>, and 
poss ipl INFO<31: 16> 
tional informaion if need more 
than 16 bits. 


INFO. rlu.v 


IMPLICIT INPUTS: 


i 
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i 

i 

i 

i 

' 

i 

i 

i 

! 

: FORS$A_CUR_LUB Current active LUB to be pushed down or 0 
: if no LUB has an 1/0 statement in progress (usual). 
' LUB$V_OPENED 1 if LUN is opened, 0 if already closed. 
i LUBSWoIFI RMS internal file id of file on this LUN. 
: Needed as input to $CLOSE. 

' LUB$V_SCRATCH 1 if this is a scratch file. 
LUBSV_READ_ONLY 1 if this file was specified READONLY in FORTRAN OPEN 
' 

i 

i 

i 

i 

i 

i 

i 

i 

i 

i 

i 

i 

i 

i 

in 


IMPLICIT OUTPUTS: 


COMPLETION STATUS: 
TRUE if success, FALSE if failure and ERR= keyword present 
SIDE EFFECTS: 


Deallocates LUB/ISB/RAB 
SIGNALS or SIGNAL_STOPs the following errors unless 


ERR= is present. 
FORS_CLOERR (28 = ‘CLOSE ERROR’) 
4x4: NCOPECLO (46 = ‘INCONSISTENT OPEN/CLOSE 


SIGNAL~ I 
ATONS') 


STOPs 
STATEMENT SPEC 


BEGIN 


GLOBAL REGISTER 
CCB = 11 : REF SFORSCCB_DECL; 
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CLOSE and default CLOSE 


BUILTIN 
ACTUALCOUNT; 


MAP 
'¢ 


is one longword. 
KEYWD : BLOCKVECTOR (100, 1]; 


t 


AL 
L_UNWIND_ACTION : V 
CCos : VOLATILE VEC 
NAM_DSC : DSCSDESCR 
DEF_DSC : DSCSDESCRiPTOR; 


ABLE 
! RESIGNAL or UNWIND if ERR= 


'¢ 


not pushed down yet) 


i Scan user parameter List and copy 
! array. SIGNAL_STOP FORS_INVARGFOR 


! and setting C 


+ 
Push down active 1/0 if 


If logical unit outside legal rang 
Stores new LUB/ISB/RAB address in 


IF (.CCB CLUBSV_OPENED)) 
F BEGIN 
: DISPOSE 


AAAANADI CRPIPIPINININIPYIPIPINUNINIPUNINPINIPINININININIPYIPININIPIPIPOPO PINON NINN PPNoNononofponoponofrornony 


FORCLOSE .B32; 1 


! Use of formal argument List as a vector of blocks, each block 


action code for handler 
! close parameter array 
! string desc for ASCIZ 
! string desc for ASCIZ 


!' Establish error handler to 


OLATILE 

TOR CCLOS$SK_KEY_MAX + 1 
IPTOR, 

ar 


FORS$SERR_OPECLO (L_UNWIND_ACTION, CLOS); ! Pass unwind action and 
! pass CLOS array with ERR= flag in CLOSCOPENSK_ERRJ 


! Set cleanup action on UNWIND to no-operation (since LUB/ISB/RAB 


L_UNWIND_ACTION = FORSK_UNWINDNOP; 


in sorted order to CLO 
(48°=INVALID ARGU 
' after 2 ae all poremzrece to see if 
OSCOPENSK_ERR] accordingly to 1 or 0 


FORSSOPECLO_ARG <KEYWD, ACTUALCOUNT (), CLOS, CLOSSK_KEY_MAX, NAM_DSC, DEF_DSC, 0); 
Allocate LUB/ISB/RAB for unit 0:99 if not already setup 


on another unit. 
active 1/0, SIGNAL_STOP FORS$_RECIO_OPE (4 


LOS 
ae TO FORTRAN 1/0 SYSTEM") 


lready has 

SIVE 1/0 OPERATION’) 
SIGNAL_STOP FORS$_INVLOGUNI (32="INVALID LOGICAL UNIT NUMBER‘) 
Common OTS$$A_COR_LUB 

Finally indicate that UNWIND cleanup action is now 
ret current LUB/ISB/RAB since it has now been sucessfully pushed. 
On return, CCB points to current control block. 


FORS$CB_PUSH (.CLOS COPENSK_UNIT], LUBSK_LUN_MIN); 
L_UNWIND_ACTION = FORSK_UNWINDRET; 


'¢ 
Check if file already CLOSEd (or not OPEN) 


nme 
=o 
rc 
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w 
mn 
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IF .CLOS COPENSK_DISPOSE] NEQ 0 
THEN 
BEGIN 


'¢ 
Turn off all dispose bits initially. 


uw 


CCB CLUBSV_PRINT 


CCB CLUBSV~SUBMIT) = 6; 
SELECT, .CLOS COPENSK_DISPOSE] OF 


ccB FLussy DELET Js 0; 


COPENSK_DIS_SAV] : 
' DISPOSE = "SAVE' 
BEGIN 


IF .CCB CLUB$V_SCRATCH] THEN FORSSSIGNAL_STO (FORSK_INCOPECLO); 
END; 


rates At DEL, OPENSK DIS _PRDE, OPENSK_DIS_SUDE] : 


eis OSE = ‘DELETE’, 'PRINT/DELETE* or *SUBMIT/DELETE' 


WAI NAB APPIN PINININININYNN 4 2 OO Oe es 


IF .CCB CLUBSV_READ_ONLY] THEN FORSSSIGNAL_STO (FORSK_INCOPECLO); 
CCB CLUBSV_DELETE]) = 1; 
END; 


COPENSK_DIS_ PRI, OPENSK_DIS_ PRDE] : 
: DISPOSE = "PRINT', 'PRINT/DELETE' 


IF .CCB CLUB$V_SCRATCH] THEN FORSSSIGNAL_STO (FORSK_INCOPECLO); 
CCB CLUBSV_PRINT) = 1; 
END; 


BREE EPO 


COPENSK_DIS_SUB, OPENSK_DIS_SUDE] : 
' DISPOSE = ‘SUBMIT’, *SUBMIT/DELETE' 


IF .CCB CLUBSV_SCRATCH) 
FORSSSIGNAL_STO (FORSK_INCOPECLO) 
CCB CLUBSV_SUBMIT] = 1; 


COTHERWISE) : 
* FORSSSIGNAL_STO (FORSK_INVARGFOR); 
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END; 
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Call procedure FORSSCLOSE_FILE to RMS close the file. 


IF ( NOT FORSSCLOSE_FILE ()) THEN FORSSSIGNAL_STO (FORSK_CLOERR); 


END 
ELSE 


14 
Set LUBSV_DEALLOC so FORSSCB_POP will deallocate the rest of the LUN. 


BEGIN 
CCB CLUBSV_DEALLOC) = 
END; 

14 

i Pop back previous LUB or irereate re 1/0 statement 


i is currently active (OTS$$A_CUR_LUB 
i In the latter case the JealTovetion will be performed right away. 


" FORS$SCB_POP (); 
1+ 


i Store success IOSTAT. If there was an error, the handler would 
du the store. 


IF .CLOS COPENSK_IOSTAT] NEQ 0 
THEN 


IF _.CLOS COPENSK_I0STAT_LJ 
.CLOS COPENSK_IOSTAT] = 0 


ELS 
BEGIN 
LOCAL 
IOSTAT : REF BLOCK C, BYTE); 
poster = “oe COPENSK _ IOSTAT); 
IOSTAT (CO, 16, 0) ="0; ! Store one word 
END; 
RETURN SS$_NORMAL ; ! RETURN success from FORSCLOSE 
END; ' END of FORSCLOSE routine 
-TITLE FORSCLOSE FORTRAN CLOSE and default CLOSE 
-IDENT \1-021\ 
-EXTRN FORSSOPECLO_ARG 
-EXTRN FORSSSIGNAL~STO 
~EXTRN ponseeee OPECLO 
.EXTRN FORSSCB PUSH: FORSS 
-EXTRN FORSSFREE _VM, FORSSCLOSE. FILE 


-PSECT _FORSCODE,NOWRT, SHR, PIC,2 
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—E DD 0 C6 PUSHL #46 
65 1 cB ¢ CALLS #1, FORS$SIGNAL_STO 
2 80 8F 88 000CB 7$ BISB2 #128, (R2) 
04 3 p| OOCF 8$ CMPL R3, &4 
6 Ss gf Sump Eaat aE ag 
11 12 S007 BNEQ 118 
54 D4 00009 9$ CLRL = RG 
07 Be 05 €1 000DB BBC #5, (R2), 10$ 
2F DD OO00DF PUSHL #4 
65 1 FB OO0E1 CALLS #1, FORSSSIGNAL_STO 
4 11 OOOES BRB 
FF OAB 0 88 900E6 10$:  BISB2 #32, -1(CCB) 
05 4 £9 OOOEA 11$: BLBC  R4, 12$ 
30 DD OOOED PUSHL #4 
65 01 FB OO0EF CALLS #1, FORSS$SIGNAL_STO 
000000006 00 00 FB OOF2 12$: CALLS #0, FORSSCLOSE_FILE 
08 50 £8 O00F9 BLBS RO, 14$ 
1¢ DD O00FC PUSHL #2 
65 01 FB OOOFE CALLS #1, FORSSSIGNAL_STO 
04 11 00101 BRB 14$ 
FF AB 10 88 00103 13$ BISB2 #16, -1(CCB) 
000000006 00 16 00107 14$ JSB FOR$$CB_POP 
68 AE 05 0010D TSTL CLOS+88 
OF 13 00110 BEQL 
05 74 AE €9 00112 BLBC  CLOS+100, 15$ 
68 BE D4 00116 CLRL  aCLOS+88 
06 11 00119 BRB 16$ 
50 68 AE 0000118 15$:  MOVL  CLOS+88, IOSTAT 
60 B4 OO11F CLRW - (IOSTATS 
50 01 00 00121 16$: MOVL #1, 
04 00124 RET 
0000 00125 17$: «WORD Save nothing 
50 08 DO 00127 MOVL B(AP), RO 
50 04 AO DO 00128 MOVL  4(RO); RO 
90 AO 9F OO12F PUSHAB CLOS 
FC AO 9F 001 PUSHAB L_UNWIND_ACTION 
ge DD 91 PUSHL #2 
E DD 1 PUSHL SP 
7 04 AC 7D 001 9 MOVQ 4(AP), -(SP) 
000000006 00 03 FB 00130 CALLS #3, FORSSERR_OPECLO 
04 00144 RET 
; Routine Size: 325 bytes, Routine Base: _FORSCODE + 0000 
12 0375 1 
1 Bee8 1 END ' END of FORSCLOSE module 
14 377 1 
15 0378 0 ELUDOM 
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Name Bytes Attributes 

_FORSCODE 325 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, 
Library Statistics 
sauces Symbols -------- Pages 

File Total Loaded Percent Mapped 
-$255SDUA28: SYSLISISTARLET 525] 9776 1 0 581 
“$255$DUA28: FORRTL.OBJJFORLIB.L32;1 711 198 27 52 
“$255$DUA28: FORRTL.OBJJRTLLIB.L 32:1 36 0 0 8 


COMMAND QUALIFIERS 
BLISS/CHECK=(FIELD, INITIAL, OPTIMIZE) /NOTRACE/LIS=LIS$:FORCLOSE/OBJ=OBJ$:FORCLOSE MSRC$:FORCLOSE/UPDATE=(ENHS$: F ORCLOSE ) 
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